home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / a_14_Handy2056213262007.psc / Handy Modules / modExeData.bas < prev    next >
BASIC Source File  |  2007-03-25  |  4KB  |  128 lines
  1. Attribute VB_Name = "modExeData"
  2. Public Property Get edPath() As String
  3.     t = App.path
  4.     If right$(t, 1) = "\" Then
  5.         t = t & App.EXEName & ".exe"
  6.     Else
  7.         t = t & "\" & App.EXEName & ".exe"
  8.     End If
  9.     edPath = t
  10. End Property
  11.  
  12. Public Function edSetData(Optional fil As String = "", Optional data As String = "")
  13.     Dim ff As Long
  14.     Dim lens As Long
  15.     Dim dat As String
  16.     If fil = "" Then fil = edPath
  17.     ff = FreeFile
  18.     Open fil For Binary As ff
  19.         dat = Space$(LOF(ff))
  20.         Get ff, , dat
  21.     Close ff
  22.     dat = dat & data
  23.     pt1 = nts4T(Len(data))
  24.     dat = dat & pt1
  25.     Kill fil
  26.     ff = FreeFile
  27.     Open fil For Binary As ff
  28.         Put ff, , dat
  29.     Close ff
  30. End Function
  31.  
  32. Public Function edGetData(Optional fil As String = "") As String
  33.     Dim ff As Long
  34.     Dim lens As Long
  35.     Dim dat As String
  36.     If fil = "" Then fil = edPath
  37.     ff = FreeFile
  38.     Open fil For Binary As ff
  39.         dat = Space$(LOF(ff))
  40.         Get ff, , dat
  41.     Close ff
  42.     If Len(dat) <= 4 Then Exit Function
  43.     lens = nts4F(right$(dat, 4))
  44.     dat = right$(dat, lens + 4)
  45.     dat = left$(dat, lens)
  46.     edGetData = dat
  47. End Function
  48.  
  49. Public Function edRemoveData(Optional fil As String = "")
  50.     Dim ff As Long
  51.     Dim lens As Long
  52.     Dim dat As String
  53.     If fil = "" Then fil = edPath
  54.     ff = FreeFile
  55.     Open fil For Binary As ff
  56.         dat = Space$(LOF(ff))
  57.         Get ff, , dat
  58.     Close ff
  59.     If Len(dat) <= 4 Then Exit Function
  60.     lens = nts4F(right$(dat, 4))
  61.     If lens = 0 Then Exit Function
  62.     Kill fil
  63.     dat = left$(dat, Len(dat) - lens - 4)
  64.     ff = FreeFile
  65.     Open fil For Binary As ff
  66.         Put ff, , dat
  67.     Close ff
  68. End Function
  69.  
  70. Private Function nts4T(num As Long) As String
  71.     Dim hlen As String
  72.     hlen = Format(Hex(num), "00000000")
  73.     If Len(hlen) <> 8 Then hlen = String(8 - Len(hlen), "0") & hlen
  74.     nts4T = Chr$(XHexToDecimall(Mid$(hlen, 1, 2))) & Chr$(XHexToDecimall(Mid$(hlen, 3, 2))) & Chr$(XHexToDecimall(Mid$(hlen, 5, 2))) & Chr$(XHexToDecimall(Mid$(hlen, 7, 2)))
  75. End Function
  76.  
  77. Private Function nts4F(num As String) As Long
  78.     If Len(num) <> 4 Then Exit Function
  79.     num = StrSetLength(Hex(Asc(Mid$(num, 1, 1))), 2, "0", 1) & StrSetLength(Hex(Asc(Mid$(num, 2, 1))), 2, "0", 1) & StrSetLength(Hex(Asc(Mid$(num, 3, 1))), 2, "0", 1) & StrSetLength(Hex(Asc(Mid$(num, 4, 1))), 2, "0", 1)
  80.     nts4F = XHexToDecimall(CStr(num))
  81. End Function
  82.  
  83. Private Function XHexToDecimall(num As String) As Long
  84.     For a = 1 To Len(num)
  85.         If Mid$(num, a, 1) <> "0" Then
  86.             Exit For
  87.         Else
  88.             zh = True
  89.         End If
  90.     Next
  91.     If zh = True Then num = Mid$(num, a)
  92.     num = UCase$(num)
  93.     Dim nums(13) As Currency
  94.     nums(1) = 1
  95.     nums(2) = 16
  96.     For a = 3 To 13
  97.         nums(a) = nums(a - 1) * 16
  98.     Next
  99.     For a = Len(num) To 1 Step -1
  100.         g = g + Mid$(num, a, 1)
  101.     Next
  102.     num = g
  103.     For a = 1 To Len(num)
  104.         gh = Mid$(num, a, 1)
  105.         If gh = "0" Then numm = 0
  106.         If gh = "1" Then numm = 1
  107.         If gh = "2" Then numm = 2
  108.         If gh = "3" Then numm = 3
  109.         If gh = "4" Then numm = 4
  110.         If gh = "5" Then numm = 5
  111.         If gh = "6" Then numm = 6
  112.         If gh = "7" Then numm = 7
  113.         If gh = "8" Then numm = 8
  114.         If gh = "9" Then numm = 9
  115.         If gh = "A" Then numm = 10
  116.         If gh = "B" Then numm = 11
  117.         If gh = "C" Then numm = 12
  118.         If gh = "D" Then numm = 13
  119.         If gh = "E" Then numm = 14
  120.         If gh = "F" Then numm = 15
  121.         numm = numm * nums(a)
  122.         gg = gg + numm
  123.     Next
  124.     XHexToDecimall = gg
  125. End Function
  126.  
  127.  
  128.